Http avec iziBasic et PP
Thursday 26 October 2006 - 11:27:59
Malgres mes divers développement sur pp, je n'ai pas oublié le premier compilateur qui m'a permit d'apprendre progressivement la programmation sur Palm. Et aujourd'hui je vous presente une applet permettant de faire des requettes http depuis iziBasic.


Requis

  • PPShell
  • pp.exe pour ARM
  • iziBasic
  • Savoir compiler avec PP
  • Savoir compiler avec iziBasic


L'applet PP (Pascal)

Deux choix sont possible :

  • Recuperer le resultat de la requête directement dans la string que retourne l'applet pp. Donc limité à 64 caractères, ce qui est plutôt contraignant.
  • Stocker le résultat de la requête dans un fichier pour être lu au complet depuis un code source iziBasic.


Nous allons voir la seconde solution.

Voici le code source de l'applet pp.




program iBHttpPP;




//

type iBasFunType=function(S:string):string;

var iBasCallPP:iBasFunType;

const
MAXMEGASTRING=16376;
//PP limits arrays to 32 k ... this one is one of the biggest you can create
// soit MAXMEGASTRING=32752;

type
u_char=UInt8;
u_short=UInt16;
u_int=UInt16;
u_long=UInt32;
size_t=UInt32;

MegaStringPtr = ^MegaStringType;
MegaStringType = Array[0..MAXMEGASTRING] of char;

const
SOCK_STREAM=netSocketTypeStream;
SOCK_DGRAM=netSocketTypeDatagram;
SOCK_RAW=netSocketTypeRaw;
SOCK_RDM=netSocketTypeReliableMsg;
AF_INET=netSocketAddrINET;
AF_RAW=netSocketAddrRaw;

type

sockaddr=record
sa_family: Int16;
sa_data: array[1..14] of UInt8;
end;

in_addr=record
case integer of
1:( s_net, s_host, s_lh, s_impno: UInt8; );
2:( s_W1, s_imp: UInt16; );
3:( s_addr: UInt32 );
end;

sockaddr_in=record
sin_family: Int16;
sin_port: u_short;
sin_addr: in_addr;
sin_zero: array[1..8] of char;
end;

/////////////////////////////////////
// StringToRessourceLab
/////////////////////////////////////
function StringToRessourceLab(const sMyString:string):integer;
begin
StringToRessourceLab:=
Ord(sMyString[4])+
256*Ord(sMyString[3])+
65536*Ord(sMyString[2])+
16777216*Ord(sMyString[1]);
end;


/////////////////////////////////////
// charcpy
// procedure pour copier une chaine
// dans la mega chaine
/////////////////////////////////////
procedure charcpy(var index:UInt16;c:MegaStringPtr;s:String);
var
i:UInt32;

begin
i:=1;
while (s[i]<>chr(0)) and (index
 c^[index]:=s[i];
 index:=index+1;
 i:=i+1;
end;

if index>MAXMEGASTRING then
 index:=MAXMEGASTRING;

end;
/////////////////////////////////////
// CreateDb
// Fonction pour creer une base de données palm
/////////////////////////////////////
Function CreateDb(resName,resCreator,rType:string):Err;
var
CardNumber:integer;
DBErr:Err;
libCreatorID:Uint32;
IDDataBase:LocalID;

Begin
CardNumber:=0;
IDDataBase:=DmFindDatabase(0,resName);
if (IDDataBase=0) then
 DBErr := DmCreateDatabase(CardNumber, resName,StringToRessourceLab(resCreator),StringToRessourceLab(rType), false);
 CreateDb:=DBErr;
end;

/////////////////////////////////////
// DelDb
// Fonction pour effacer une base de données palm
/////////////////////////////////////
Procedure DelDb(resName:string);
var
 CardNumber:integer;
 DBErr:Err;
 IDDataBase:localID;

Begin

 CardNumber:=0;
 IDDataBase:=DmFindDatabase(0,resName);
 if (IDDataBase>0) then
  DBErr := DmDeleteDatabase(CardNumber, IDDataBase);

end;

/////////////////////////////////////
// WriteHTTP
// Fonction pour ecrire la mega chaine
// Dans une base de données palm
/////////////////////////////////////
procedure WriteHTTP(fichier:String;s:MegaStringPtr;size:UInt32);
var
 h:Memhandle;
 pp:Pointer;
 u:UInt16;
 e:Err;
 gDataBase:DmOpenRef;
 IDDataBase:LocalID;

begin
 IDDataBase:=DmFindDatabase(0,fichier);
 if (IDDataBase<>0) then Begin
  gDataBase:=DmOpenDatabase(0,IDDataBase,dmModeReadWrite);
  if (gDataBase<>nil) then begin
   if DmNumRecords(gDataBase)<65000 then begin
    u:=0; // new record
    h:=DmNewRecord(gDataBase,u,size);
    if h<>nil then begin
     pp:=MemHandleLock(h);
     if pp <> nil then begin
      DmWrite(pp,0,s,size);
      DmReleaseRecord(gDataBase,u,true);
      MemHandleUnlock(h); // PG 22022004
     end;
    end;
   end;
   DmCloseDatabase(gDataBase);
  end;
 end;
end;

/////////////////////////////////////
// getbyname
// The main function of the applet.
// Ici nous allons construire la requette http
// l envoyer, et ecrire le resultat dans une 
// base de données palm
/////////////////////////////////////

function getbyname(fichier:string;domain:string;page:String;port:UInt16):String;
var
 size,received:UInt16;
 refsocket:NetSocketRef;
 address:NetSocketAddrType;
 address_in:NetSocketAddrINType;
 address_inaddrPtr:Pointer;
 host:NetHostInfoBufType;
 requetehttp:MegaStringPtr;
 indexrequetehttp:UInt16;
 endline:string;
 libRef:UInt16;
 error:UInt16;
 erreur:Err;
 y,nb:UInt16;
 AppNetTimeout: Int32;
 AppNetRefnum: UInt16;
 sent:UInt16;
 saved:WinHandle;

begin
 AppNetRefnum:=0;
 error:=0;
 //Recherche de la netlib
 SysLibFind('Net.lib',AppNetRefnum);
 //Set timeout
 AppNetTimeout:=30*100;
 //Init of the megastring buffer
 requetehttp:=MemPtrNew(sizeof(char)*MAXMEGASTRING);
 //Test if buffer is correctly initializing.
 if requetehttp=nil then begin
  error:=1;
  getbyname:='Error in memory allocating ...';
 end;

 //Si le buffer est bien initialise alors nous attaquons
 if error=0 then begin
  //Opening netlib
  erreur:=NetLibOpen(AppNetRefnum,error);//,error);

  //If it s ok ... so
  if (error=0) or (error=$1201) then begin
   //We ask the ip of the hostname to the dns.
   NetLibGetHostByName(AppNetRefnum, domain,@host,AppNetTimeout,error);
   //We forge the socket
   refsocket:=NetLibSocketOpen(AppNetRefnum,netSocketAddrINET,netSocketTypeStream,6,AppNetTimeout,error);
   if refsocket<>0 then begin
    address_in.addr:=host.address[0];
    address_in.family:= 2;
    address_in.port:=port;
    //Connecting socket
    error:=NetLibSocketConnect(AppNetRefnum,refsocket,@address_in,sizeof(address_in),AppNetTimeout,erreur);

    if erreur=0 then begin
    //Forge de la requete http
     endline:=CHR(13)+CHR(10);
     indexrequetehttp:=0;
     charcpy(indexrequetehttp,requetehttp,'GET '+page);
     charcpy(indexrequetehttp,requetehttp,' HTTP/1.1'+endline+'host: '+domain+endline);
     charcpy(indexrequetehttp,requetehttp,'Connection: close'+endline);
     charcpy(indexrequetehttp,requetehttp,'User-Agent: Palm'+endline); 
    charcpy(indexrequetehttp,requetehttp,endline); 
    //We send the request until all is sent or an error occur
    sent:=0;
    error:=1;
    while (sent0) and (erreur=0) do begin
     error:=NetLibSend(AppNetRefnum,refsocket,@requetehttp^[sent],indexrequetehttp-sent,0,nil,0,AppNetTimeout,erreur);
     sent:=sent+error;
    end;

    //if nothing is sent then error occurs
    if sent<=0 then getbyname:='Error while sending...';

    //We read answer in the netlib buffer until the buffer is clear
    error:=1;
    erreur:=0;
    sent:=0; 
    while (error>0) and ((MAXMEGASTRING-sent)>1) and (erreur=0) do begin
     error:=NetLibReceive(AppNetRefnum,refsocket,@requetehttp^[sent],(MAXMEGASTRING-sent),0,nil,nil,AppNetTimeout,erreur);
     sent:=sent+error;
    end;

    //We del the file
    DelDb(fichier);
    //We create a new palm database
    CreateDb(fichier,('Khrt'),('http'));
    //We write the result of the request
    WriteHTTP(fichier,requetehttp,sent);
   end else begin
    getbyname:='Can t open socket';
   end;
   NetLibSocketClose(AppNetRefnum, refsocket,AppNetTimeout,erreur);
  end else begin
   getbyname:='Can t create socket';
  end;
  NetLibClose(AppNetRefnum,0);
 end else begin
  getbyname:='Can t open netlib';
 end;
end;

MemPtrFree(requetehttp);
end;


//Fonction appele par iziBasic lors d un CallPP
function CallPP(S:string):string;
var
 url,fichier,domain,page,port:String;
 i,u:UInt16;

begin
 url:='';
 fichier:='';
 domain:='';
 page:=''; 
 port:='';
 i:=1; 
 u:=0;

 //Tokenize of the iziBasic call parameter string
 // le fichier
 // le domaine
 // la page 
 // le port
 while (S[i]<>CHR(0)) and (i<=64) do begin
  if (S[i]<>CHR(10)) then begin
   case u of
    0: begin fichier:=fichier+S[i]; end;
    1: begin url:=url+S[i]; end;
    2: begin port:=port+S[i]; end;
  end;
  end else begin
  u:=u+1;
 end;
 i:=i+1;
 end;


 i:=1;
 u:=0;
 while (url[i]<>CHR(0)) and (i<=64) do begin
  if (url[i]<>'/') then begin
   if u=0 then begin
    domain:=domain+url[i];
   end else begin
    page:=page+url[i];
   end;
  end else begin
   u:=1;
   page:=page+url[i];
  end;

  i:=i+1;
 end;
 CallPP:=getbyname(fichier,domain,page,StrAToI(port));
// CallPP:=port;
end;

begin
 iBasCallPP:=CallPP;
end.


Donc rien de bien compliqué, seulement un accés à une api que l'on a pas sous iziBasic, à savoir la NetLib.

Le code iziBasic

Je vais maintenant vous montrer comment utiliser notre applet PP avec izibasic.


' iBHttpPP.ibas



BEGIN
LABEL #1,"Fichier : TESTHTTP",2,30
LABEL #2,"URL : khertan.net/index.php",2,40
LABEL #3,"Port : 80",2,50

REM The parameter string
REM The file (here : TESTHTTP)
REM CHR$(10)
REM URL (here : khertan.net/index.php)
REM CHR$(10)
REM The port : (here : 80)

R$="TESTHTTP"+CHR$(10)+"khertan.net/index.php"+CHR$(10)+"80"
A$=CALLPP$(100,R$)

A=FILEERROR
IF A=0 THEN
 A$="PP Code replied: '"+A$+"'"
ELSE
 A$="PP Code was not found!"
ENDIF

LABEL #4,A$,2,80

REPEAT : A=DOEVENTS : UNTIL A=-1
END


Conclusion
Tout est possible à présent ...



Khertan.net by Benoit HERVIER Alias Khertan.